=========================================================================== BBS: The Abacus * HST/DS * Potterville, MI Date: 03-15-93 (13:48) Number: 77 From: ARTHUR SHIPKOWSKI Refer#: NONE To: ALL Recvd: NO Subj: The beginning... Conf: (35) Quick Basi --------------------------------------------------------------------------- 'Yo All! (Yo?!?) 'I'd like to show you how unbloated the ancestor of postit was in its last 'QB-c ompatible version: ' .------------------------------------------------------. ' | BIN2QB.BAS by Allan Zachary Public Domain 7/92 | ' | Converts binary files to echo-compatible text files | ' | version 3.3 - replaces a fallible checksum in v3.1 | ' | < Bar Charts progress, Manual or Batch style input > | ' | BATCH SYNTAX: BIN2QB infile.ext outfile.ext | ' `------------------------------------------------------' DEFINT A-Z DECLARE FUNCTION Bin2Txt$ (ThreeBytes$) ' 3 binary bytes in returns DIM SHARED XCk& ' 4 printable Text bytes out Q$ = CHR$(34): MaxFileSz& = 32760 Bin$ = RTRIM$(COMMAND$) ' (QBASIC users put 'REM' before this line.) Split = INSTR(Bin$, " ") IF Split = 0 THEN INPUT "Filename of file to convert:", InFile$ INPUT "Output filename:", OutFile$ ELSE InFile$ = LEFT$(Bin$, Split - 1) OutFile$ = RIGHT$(Bin$, LEN(Bin$) - Split) END IF COLOR 12, 0: Bin$ = "" IF LEN(InFile$) THEN OPEN InFile$ FOR BINARY AS #2 Size& = LOF(2): FSiz& = Size& ELSE InFile$ = "File" END IF IF Size& > MaxFileSz& THEN PRINT "Aborted- File too large for Bin2Qb!" BEEP: COLOR 7, 0: END END IF IF Size& THEN ON ERROR GOTO DoIt OPEN OutFile$ FOR INPUT AS #1 CLOSE #1: COLOR 12, 0: PRINT OutFile$; " already exists!!" BEEP: COLOR 7, 0: END DoIt: CLOSE #1: CLS COLOR 11, 0: PRINT "BIN2QB 3.3 by Allan Zachary Creating "; OutFile$ OPEN OutFile$ FOR OUTPUT AS #1 PRINT #1, "DEFINT A-Z ' Created by BIN2QB 3.3 freeware 7/92" PRINT #1, "f$="; Q$; InFile$; Q$; ":LSBs=3" PRINT #1, "CLS : PRINT "; Q$; "Creating "; Q$; ";f$" PRINT #1, "OPEN f$ FOR BINARY AS #1 :FSize&="; FSiz& PRINT #1, "ON ERROR GOTO Done:LOCATE 2,1:PRINT STRING$(78,176)" PRINT #1, "DO" PRINT #1, " READ Lyne$:LynLen=LEN(Lyne$)" PRINT #1, " FOR i=1 TO LynLen " PRINT #1, " Power=((i-1)MOD 4)*6" PRINT #1, " B&=(ASC(MID$(Lyne$,i,1))-59)*2^Power:C&=C&+B&" PRINT #1, " IF i MOD 4=0 THEN" PRINT #1, " Stored&=Stored&+3:XCk&=XCk& XOR C&:LOCATE 2,1" PRINT #1, " PRINT STRING$(CINT(Stored&/FSize&*78),219);" PRINT #1, " IF Stored&>FSize& THEN LSBs=3+(FSize&-Stored&)" PRINT #1, " Bin$=LEFT$(MKL$(C&),LSBs):PUT #1,,Bin$:C&=0" PRINT #1, " ENDIF" PRINT #1, " NEXT i:LOOP" Lyne$ = "DATA " BufSz& = FRE(Buf$) - 1024 IF BufSz& > Size& THEN BufSz& = Size& Buf$ = SPACE$(BufSz&) LOCATE 2, 1: PRINT STRING$(78, 176); : COLOR 10, 0 DO GET #2, , Buf$ FOR i = 1 TO LEN(Buf$) Done& = Done& + 1 Ascii = ASC(MID$(Buf$, i, 1)) Bin$ = Bin$ + CHR$(Ascii) IF LEN(Bin$) = 3 THEN IF LEN(Lyne$) >= 69 THEN 'save it, and start a new line... PRINT #1, Lyne$ LOCATE 2, 1: PRINT STRING$(CINT(Done& / Size& * 78), 219) Lyne$ = "DATA " + Bin2Txt$(Bin$) ELSE 'keep building this line... Lyne$ = Lyne$ + Bin2Txt$(Bin$) END IF Bin$ = "" END IF NEXT i Size& = Size& - BufSz& IF BufSz& > Size& THEN BufSz& = Size& Buf$ = SPACE$(BufSz&) LOOP WHILE LEN(Buf$) 'Until the last character has been read. Size& = LEN(Bin$) IF Size& THEN Bin$ = Bin2Txt$(Bin$) IF LEN(Lyne$) >= 69 THEN PRINT #1, Lyne$ IF Size& THEN PRINT #1, "DATA " + Bin$ ELSE PRINT #1, Lyne$ + Bin$ END IF LOCATE 2, 1: PRINT STRING$(CINT(Done& / FSiz& * 78), 219) PRINT #1, "Done:CLOSE #1: PRINT" PRINT #1, "IF XCk&<>"; XCk&; " THEN " PRINT #1, " PRINT "; Q$; "DATA corrupt! File deleted."; Q$ PRINT #1, " KILL f$" PRINT #1, "ELSE" PRINT #1, " PRINT f$;"; Q$; " created."; Q$ PRINT #1, "END IF:END" CLOSE COLOR 11, 0: PRINT "done." ELSE PRINT InFile$; " doesn't exist, or has no length!" CLOSE END IF COLOR 7, 0: END FUNCTION Bin2Txt$ (ThreeBytes$) L = LEN(ThreeBytes$) N& = CVL(ThreeBytes$ + STRING$(4 - L, 0)) XCk& = XCk& XOR N& FourBytes$ = ""' .---Offset into Character set FOR j = 1 TO 4 ' | Tmp$ = CHR$((N& AND 63) + 59) N& = N& \ 64 FourBytes$ = FourBytes$ + Tmp$ NEXT j Bin2Txt$ = FourBytes$ END FUNCTION 'A Little under 130 lines! 'Take Care, Arthur Shipkowski --- * Origin: [The BASIC Point] [North Greece, NY] (1:2613/313.2) SEEN-BY: 1/211 11/2 4 13/13 101/1 108/89 109/25 110/69 114/5 123/19 124/1 SEEN-BY: 153/752 154/40 77 157/2 159/100 125 430 950 203/23 209/209 280/1 SEEN-BY: 390/1 396/1 15 397/2 2230/100 3603/20